home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / utility / sml-mode-3.3b / sml-mode.el < prev    next >
Encoding:
Text File  |  1997-08-18  |  42.4 KB  |  1,132 lines  |  [TEXT/R*ch]
  1. ;;; sml-mode.el. Major mode for editing (Standard) ML. Version 3.3(beta)
  2.  
  3. ;; Copyright (C) 1989, Lars Bo Nielsen; 1994,1997, Matthew J. Morley
  4.  
  5. ;; $Revision: 3.14 $
  6. ;; $Date: 1997/07/04 11:37:33 $
  7.  
  8. ;; This file is not part of GNU Emacs, but it is distributed under the
  9. ;; same conditions.
  10.  
  11. ;; ====================================================================
  12.  
  13. ;; This program is free software; you can redistribute it and/or
  14. ;; modify it under the terms of the GNU General Public License as
  15. ;; published by the Free Software Foundation; either version 2, or (at
  16. ;; your option) any later version.
  17.  
  18. ;; This program is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  25. ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26.  
  27. ;; ====================================================================
  28.  
  29. ;;; HISTORY 
  30.  
  31. ;; Still under construction: History obscure, needs a biographer as
  32. ;; well as a M-x doctor. Change Log on request.
  33.  
  34. ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
  35.  
  36. ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
  37. ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
  38. ;; and numerous bugs and bug-fixes.
  39.  
  40. ;;; DESCRIPTION 
  41.  
  42. ;; See accompanying info file: sml-mode.info
  43.  
  44. ;;; FOR YOUR .EMACS FILE
  45.  
  46. ;; If sml-mode.el lives in some non-standard directory, you must tell 
  47. ;; emacs where to get it. This may or may not be necessary:
  48.  
  49. ;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
  50.  
  51. ;; Then to access the commands autoload sml-mode with that command:
  52.  
  53. ;; (autoload 'sml-mode "sml-mode" "Major mode for editing ML programs." t)
  54. ;;
  55. ;; If files ending in ".sml" or ".ML" are hereafter considered to contain
  56. ;; Standard ML source, put their buffers into sml-mode automatically:
  57.  
  58. ;; (setq auto-mode-alist
  59. ;;       (cons '(("\\.sml$" . sml-mode)
  60. ;;               ("\\.ML$"  . sml-mode)) auto-mode-alist))
  61.  
  62. ;; Here's an example of setting things up in the sml-mode-hook:
  63.  
  64. ;; (setq sml-mode-hook
  65. ;;       '(lambda() "ML mode hacks"
  66. ;;          (setq sml-indent-level 2         ; conserve on horiz. space
  67. ;;                indent-tabs-mode nil)))    ; whatever
  68.  
  69. ;; sml-mode-hook is run whenever a new sml-mode buffer is created.
  70. ;; There is an sml-load-hook too, which is only run when this file is
  71. ;; loaded. One use for this hook is to select your preferred
  72. ;; highlighting scheme, like this:
  73.  
  74. ;; (setq sml-load-hook
  75. ;;       '(lambda() "Highlights." (require 'sml-hilite)))
  76.  
  77. ;; hilit19 is the magic that actually does the highlighting. My set up
  78. ;; for hilit19 runs something like this:
  79.  
  80. ;; (if window-system
  81. ;;     (setq hilit-background-mode   t ; monochrome (alt: 'dark or 'light)
  82. ;;           hilit-inhibit-hooks     nil
  83. ;;           hilit-inhibit-rebinding nil
  84. ;;           hilit-quietly           t))
  85.  
  86. ;; Alternatively, you can (require 'sml-font) which uses the font-lock
  87. ;; package instead. 
  88.  
  89. ;; Finally, there are inferior-sml-{mode,load}-hooks -- see comments
  90. ;; in sml-proc.el. For much more information consult the mode's *info*
  91. ;; tree.
  92.  
  93. ;;; VERSION STRING
  94.  
  95. (defconst sml-mode-version-string
  96.   "sml-mode, version 3.3(beta)")
  97.  
  98. (provide 'sml-mode)
  99.  
  100. ;;; VARIABLES CONTROLLING INDENTATION
  101.  
  102. (defvar sml-indent-level 4
  103.   "*Indentation of blocks in ML (see also `sml-structure-indent').")
  104.  
  105. (defvar sml-structure-indent 4          ; Not currently an option.
  106.   "Indentation of signature/structure/functor declarations.")
  107.  
  108. (defvar sml-pipe-indent -2
  109.   "*Extra (usually negative) indentation for lines beginning with |.")
  110.  
  111. (defvar sml-case-indent nil
  112.   "*How to indent case-of expressions.
  113.     If t:   case expr                     If nil:   case expr of
  114.               of exp1 => ...                            exp1 => ...
  115.                | exp2 => ...                          | exp2 => ...
  116.  
  117. The first seems to be the standard in SML/NJ, but the second
  118. seems nicer...")
  119.  
  120. (defvar sml-nested-if-indent nil
  121.   "*Determine how nested if-then-else will be formatted:
  122.     If t: if exp1 then exp2               If nil:   if exp1 then exp2
  123.           else if exp3 then exp4                    else if exp3 then exp4
  124.           else if exp5 then exp6                         else if exp5 then exp6
  125.                else exp7                                      else exp7")
  126.  
  127. (defvar sml-type-of-indent t
  128.   "*How to indent `let' `struct' etc.
  129.     If t:  fun foo bar = let              If nil:  fun foo bar = let
  130.                              val p = 4                 val p = 4
  131.                          in                        in
  132.                              bar + p                   bar + p
  133.                          end                       end
  134.  
  135. Will not have any effect if the starting keyword is first on the line.")
  136.  
  137. (defvar sml-electric-semi-mode nil
  138.   "*If t, `\;' will self insert, reindent the line, and do a newline.
  139. If nil, just insert a `\;'. (To insert while t, do: C-q \;).")
  140.  
  141. (defvar sml-paren-lookback 1000
  142.   "*How far back (in chars) the indentation algorithm should look
  143. for open parenthesis. High value means slow indentation algorithm. A
  144. value of 1000 (being the equivalent of 20-30 lines) should suffice
  145. most uses. (A value of nil, means do not look at all)")
  146.  
  147. ;;; OTHER GENERIC MODE VARIABLES
  148.  
  149. (defvar sml-mode-info "sml-mode"
  150.   "*Where to find Info file for sml-mode.
  151. The default assumes the info file \"sml-mode.info\" is on Emacs' info
  152. directory path. If it is not, either put the file on the standard path
  153. or set the variable sml-mode-info to the exact location of this file
  154. which is part of the sml-mode 3.2 (and later) distribution. E.g:  
  155.  
  156.   (setq sml-mode-info \"/usr/me/lib/info/sml-mode\") 
  157.  
  158. in your .emacs file. You can always set it interactively with the
  159. set-variable command.")
  160.  
  161. (defvar sml-mode-hook nil
  162.   "*This hook is run when sml-mode is loaded, or a new sml-mode buffer created.
  163. This is a good place to put your preferred key bindings.")
  164.  
  165. (defvar sml-load-hook nil
  166.   "*This hook is run when sml-mode (sml-mode.el) is loaded into Emacs.")
  167.  
  168. (defvar sml-mode-abbrev-table nil "*SML mode abbrev table (default nil)")
  169.  
  170. (defvar sml-error-overlay t
  171.   "*Non-nil means use an overlay to highlight errorful code in the buffer.
  172.  
  173. This gets set when `sml-mode' is invoked\; if you don't like/want SML 
  174. source errors to be highlighted in this way, do something like
  175.  
  176.   \(setq-default sml-error-overlay nil\)
  177.  
  178. in your `sml-load-hook', say.")
  179.  
  180. (make-variable-buffer-local 'sml-error-overlay)
  181.  
  182. ;;; CODE FOR SML-MODE 
  183.  
  184. (defun sml-mode-info ()
  185.   "Command to access the TeXinfo documentation for sml-mode.
  186. See doc for the variable sml-mode-info."
  187.   (interactive)
  188.   (require 'info)
  189.   (condition-case nil
  190.       (funcall 'Info-goto-node (concat "(" sml-mode-info ")"))
  191.     (error (progn
  192.              (describe-variable 'sml-mode-info)
  193.              (message "Can't find it... set this variable first!")))))
  194.  
  195. (defun sml-indent-level (&optional indent)
  196.    "Allow the user to change the block indentation level. Numeric prefix 
  197. accepted in lieu of prompting."
  198.    (interactive "NIndentation level: ")
  199.    (setq sml-indent-level indent))
  200.  
  201. (defun sml-pipe-indent (&optional indent)
  202.   "Allow to change pipe indentation level (usually negative). Numeric prefix
  203. accepted in lieu of prompting."
  204.    (interactive "NPipe Indentation level: ")
  205.    (setq sml-pipe-indent indent))
  206.  
  207. (defun sml-case-indent (&optional of)
  208.   "Toggle sml-case-indent. Prefix means set it to nil."
  209.   (interactive "P")
  210.   (setq sml-case-indent (and (not of) (not sml-case-indent)))
  211.   (if sml-case-indent (message "%s" "true") (message "%s" nil)))
  212.  
  213. (defun sml-nested-if-indent (&optional of)
  214.   "Toggle sml-nested-if-indent. Prefix means set it to nil."
  215.   (interactive "P")
  216.   (setq sml-nested-if-indent (and (not of) (not sml-nested-if-indent)))
  217.   (if sml-nested-if-indent (message "%s" "true") (message "%s" nil)))
  218.  
  219. (defun sml-type-of-indent (&optional of)
  220.   "Toggle sml-type-of-indent. Prefix means set it to nil."
  221.   (interactive "P")
  222.   (setq sml-type-of-indent (and (not of) (not sml-type-of-indent)))
  223.   (if sml-type-of-indent (message "%s" "true") (message "%s" nil)))
  224.  
  225. (defun sml-electric-semi-mode (&optional of)
  226.   "Toggle sml-electric-semi-mode. Prefix means set it to nil."
  227.   (interactive "P")
  228.   (setq sml-electric-semi-mode (and (not of) (not sml-electric-semi-mode)))
  229.   (message "%s" (concat "Electric semi mode is " 
  230.                    (if sml-electric-semi-mode "on" "off"))))
  231.  
  232. ;;; BINDINGS: these should be common to the source and process modes...
  233.  
  234. (defun install-sml-keybindings (map)
  235.   ;; Text-formatting commands:
  236.   (define-key map "\C-c\C-m" 'sml-insert-form)
  237.   (define-key map "\C-c\C-i" 'sml-mode-info)
  238.   (define-key map "\M-|"     'sml-electric-pipe)
  239.   (define-key map "\;"       'sml-electric-semi)
  240.   (define-key map "\M-\t"    'sml-back-to-outer-indent)
  241.   (define-key map "\C-j"     'newline-and-indent)
  242.   (define-key map "\177"     'backward-delete-char-untabify)
  243.   (define-key map "\C-\M-\\" 'sml-indent-region)
  244.   (define-key map "\t"       'sml-indent-line) ; ...except this one
  245.   ;; Process commands added to sml-mode-map -- these should autoload
  246.   (define-key map "\C-c\C-l" 'sml-load-file)
  247.   (define-key map "\C-c`"    'sml-next-error))
  248.  
  249. ;;; Autoload functions -- no-doc is another idea cribbed from AucTeX!
  250.  
  251. (defvar sml-no-doc
  252.   "This function is part of sml-proc, and has not yet been loaded.
  253. Full documentation will be available after autoloading the function."
  254.   "Documentation for autoloading functions.")
  255.  
  256. (autoload 'sml             "sml-proc"   sml-no-doc t)
  257. (autoload 'sml-load-file   "sml-proc"   sml-no-doc t)
  258.  
  259. (autoload 'switch-to-sml   "sml-proc"   sml-no-doc t)
  260. (autoload 'sml-send-region "sml-proc"   sml-no-doc t)
  261. (autoload 'sml-send-buffer "sml-proc"   sml-no-doc t)
  262. (autoload 'sml-next-error  "sml-proc"   sml-no-doc t)
  263.  
  264. (defvar sml-mode-map nil "The keymap used in sml-mode.")
  265. (cond ((not sml-mode-map)
  266.        (setq sml-mode-map (make-sparse-keymap))
  267.        (install-sml-keybindings sml-mode-map)
  268.        (define-key sml-mode-map "\C-c\C-s" 'switch-to-sml)
  269.        (define-key sml-mode-map "\C-c\C-r" 'sml-send-region)
  270.        (define-key sml-mode-map "\C-c\C-b" 'sml-send-buffer)))
  271.  
  272. ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S
  273.  
  274. (cond ((fboundp 'make-extent)
  275.        ;; suppose this is XEmacs
  276.  
  277.        (defun sml-make-overlay ()
  278.          "Create a new text overlay (extent) for the SML buffer."
  279.          (let ((ex (make-extent 1 1)))
  280.            (set-extent-property ex 'face 'zmacs-region) ex))
  281.  
  282.        (defalias 'sml-is-overlay 'extentp)
  283.  
  284.        (defun sml-overlay-active-p ()
  285.          "Determine whether the current buffer's error overlay is visible."
  286.          (and (sml-is-overlay sml-error-overlay)
  287.               (not (zerop (extent-length sml-error-overlay)))))
  288.  
  289.        (defalias 'sml-move-overlay 'set-extent-endpoints))
  290.  
  291.       ((fboundp 'make-overlay)
  292.        ;; otherwise assume it's Emacs
  293.  
  294.        (defun sml-make-overlay ()
  295.          "Create a new text overlay (extent) for the SML buffer."
  296.          (let ((ex (make-overlay 0 0)))
  297.            (overlay-put ex 'face 'region) ex))
  298.  
  299.        (defalias 'sml-is-overlay 'overlayp)
  300.  
  301.        (defun sml-overlay-active-p ()
  302.          "Determine whether the current buffer's error overlay is visible."
  303.          (and (sml-is-overlay sml-error-overlay)
  304.               (not (equal (overlay-start sml-error-overlay)
  305.                           (overlay-end sml-error-overlay)))))
  306.  
  307.        (defalias 'sml-move-overlay 'move-overlay))
  308.       (t
  309.        ;; what *is* this!?
  310.        (defalias 'sml-is-overlay 'ignore)
  311.        (defalias 'sml-overlay-active-p 'ignore)
  312.        (defalias 'sml-make-overlay 'ignore)
  313.        (defalias 'sml-move-overlay 'ignore)))
  314.  
  315. ;;; MORE CODE FOR SML-MODE
  316.  
  317. (defun sml-mode-version ()
  318.   "This file's version number (sml-mode)."
  319.   (interactive)
  320.   (message sml-mode-version-string))
  321.  
  322. (defvar sml-mode-syntax-table nil "The syntax table used in sml-mode.")
  323. (if sml-mode-syntax-table
  324.     ()
  325.   (setq sml-mode-syntax-table (make-syntax-table))
  326.   ;; Set everything to be "." (punctuation) except for [A-Za-z0-9],
  327.   ;; which will default to "w" (word-constituent).
  328.   (let ((i 0))
  329.     (while (< i ?0)
  330.       (modify-syntax-entry i "." sml-mode-syntax-table)
  331.       (setq i (1+ i)))
  332.     (setq i (1+ ?9))
  333.     (while (< i ?A)
  334.       (modify-syntax-entry i "." sml-mode-syntax-table)
  335.       (setq i (1+ i)))
  336.     (setq i (1+ ?Z))
  337.     (while (< i ?a)
  338.       (modify-syntax-entry i "." sml-mode-syntax-table)
  339.       (setq i (1+ i)))
  340.     (setq i (1+ ?z))
  341.     (while (< i 128)
  342.       (modify-syntax-entry i "." sml-mode-syntax-table)
  343.       (setq i (1+ i))))
  344.  
  345.   ;; Now we change the characters that are meaningful to us.
  346.   (modify-syntax-entry ?\(      "()1"   sml-mode-syntax-table)
  347.   (modify-syntax-entry ?\)      ")(4"   sml-mode-syntax-table)
  348.   (modify-syntax-entry ?\[      "(]"    sml-mode-syntax-table)
  349.   (modify-syntax-entry ?\]      ")["    sml-mode-syntax-table)
  350.   (modify-syntax-entry ?{       "(}"    sml-mode-syntax-table)
  351.   (modify-syntax-entry ?}       "){"    sml-mode-syntax-table)
  352.   (modify-syntax-entry ?\*      ". 23"  sml-mode-syntax-table)
  353.   (modify-syntax-entry ?\"      "\""    sml-mode-syntax-table)
  354.   (modify-syntax-entry ?        " "     sml-mode-syntax-table)
  355.   (modify-syntax-entry ?\t      " "     sml-mode-syntax-table)
  356.   (modify-syntax-entry ?\n      " "     sml-mode-syntax-table)
  357.   (modify-syntax-entry ?\f      " "     sml-mode-syntax-table)
  358.   (modify-syntax-entry ?\'      "w"     sml-mode-syntax-table)
  359.   (modify-syntax-entry ?\_      "w"     sml-mode-syntax-table))
  360.  
  361. ;;;###Autoload
  362. (defun sml-mode ()
  363.   "Major mode for editing ML code.
  364. Tab indents for ML code.
  365. Comments are delimited with (* ... *).
  366. Blank lines and form-feeds separate paragraphs.
  367. Delete converts tabs to spaces as it moves back.
  368.  
  369. For information on running an inferior ML process, see the documentation
  370. for inferior-sml-mode (set this up with \\[sml]).
  371.  
  372. Customisation: Entry to this mode runs the hooks on sml-mode-hook.
  373.  
  374. Variables controlling the indentation
  375. =====================================
  376.  
  377. Seek help (\\[describe-variable]) on individual variables to get current settings.
  378.  
  379. sml-indent-level (default 4)
  380.     The indentation of a block of code.
  381.  
  382. sml-pipe-indent (default -2)
  383.     Extra indentation of a line starting with \"|\".
  384.  
  385. sml-case-indent (default nil)
  386.     Determine the way to indent case-of expression.
  387.  
  388. sml-nested-if-indent (default nil)
  389.     Determine how nested if-then-else expressions are formatted.
  390.  
  391. sml-type-of-indent (default t)
  392.     How to indent let, struct, local, etc.
  393.     Will not have any effect if the starting keyword is first on the line.
  394.  
  395. sml-electric-semi-mode (default nil)
  396.     If t, a `\;' will reindent line, and perform a newline.
  397.  
  398. sml-paren-lookback (default 1000)
  399.     Determines how far back (in chars) the indentation algorithm should 
  400.     look to match parenthesis. A value of nil, means do not look at all.
  401.  
  402. Mode map
  403. ========
  404. \\{sml-mode-map}"
  405.  
  406.   (interactive)
  407.   (kill-all-local-variables)
  408.   (sml-mode-variables)
  409.   (use-local-map sml-mode-map)
  410.   (setq major-mode 'sml-mode)
  411.   (setq mode-name "SML")
  412.   (run-hooks 'sml-mode-hook))            ; Run the hook last
  413.  
  414. (defun sml-mode-variables ()
  415.   (set-syntax-table sml-mode-syntax-table)
  416.   (setq local-abbrev-table sml-mode-abbrev-table)
  417.   ;; A paragraph is separated by blank lines or ^L only.
  418.   (make-local-variable 'paragraph-start)
  419.   (setq paragraph-start (concat "^[\t ]*$\\|" page-delimiter))
  420.   (make-local-variable 'paragraph-separate)
  421.   (setq paragraph-separate paragraph-start)
  422.   (make-local-variable 'indent-line-function)
  423.   (setq indent-line-function 'sml-indent-line)
  424.   (make-local-variable 'comment-start)
  425.   (setq comment-start "(* ")
  426.   (make-local-variable 'comment-end)
  427.   (setq comment-end " *)")
  428.   (make-local-variable 'comment-column)
  429.   (setq comment-column 40)              
  430.   (make-local-variable 'comment-start-skip)
  431.   (setq comment-start-skip "(\\*+[ \t]?")
  432.   (make-local-variable 'comment-indent-function)
  433.   (setq comment-indent-function 'sml-comment-indent)
  434.   (setq sml-error-overlay (and sml-error-overlay (sml-make-overlay))))
  435.  
  436.   ;; Adding these will fool the matching of parens -- because of a
  437.   ;; bug in Emacs (in scan_lists, i think)... it would be nice to 
  438.   ;; have comments treated as white-space.
  439.   ;;(make-local-variable 'parse-sexp-ignore-comments)
  440.   ;;(setq parse-sexp-ignore-comments t)
  441.  
  442. (defun sml-error-overlay (undo &optional beg end buffer)
  443.   "Move `sml-error-overlay' so it surrounds the text region in the
  444. current buffer. If the buffer-local variable `sml-error-overlay' is
  445. non-nil it should be an overlay \(or extent, in XEmacs speak\)\; this
  446. function moves the overlay over the current region. If the optional
  447. BUFFER argument is given, move the overlay in that buffer instead of
  448. the current buffer.
  449.  
  450. Called interactively, the optional prefix argument UNDO indicates that
  451. the overlay should simply be removed: \\[universal-argument] \
  452. \\[sml-error-overlay]."
  453.   (interactive "P")
  454.   (save-excursion
  455.     (set-buffer (or buffer (current-buffer)))
  456.     (if (sml-is-overlay sml-error-overlay)
  457.         (if undo
  458.             (sml-move-overlay sml-error-overlay 1 1)
  459.           ;; if active regions, signals mark not active if no region set
  460.           (let ((beg (or beg (region-beginning)))
  461.                 (end (or end (region-end))))
  462.             (sml-move-overlay sml-error-overlay beg end))))))
  463.  
  464. (defconst sml-pipe-matchers-reg
  465.   "\\bcase\\b\\|\\bfn\\b\\|\\bfun\\b\\|\\bhandle\\b\
  466. \\|\\bdatatype\\b\\|\\babstype\\b\\|\\band\\b"
  467.   "The keywords a `|' can follow.")
  468.  
  469. (defun sml-electric-pipe ()
  470.   "Insert a \"|\". 
  471. Depending on the context insert the name of function, a \"=>\" etc."
  472.   (interactive)
  473.   (let ((case-fold-search nil)          ; Case sensitive
  474.         (here (point))
  475.         (match (save-excursion
  476.                  (sml-find-matching-starter sml-pipe-matchers-reg)
  477.                  (point)))
  478.         (tmp "  => ")
  479.         (case-or-handle-exp t))
  480.     (if (/= (save-excursion (beginning-of-line) (point))
  481.             (save-excursion (skip-chars-backward "\t ") (point)))
  482.         (insert "\n"))
  483.     (insert "|")
  484.     (save-excursion
  485.       (goto-char match)
  486.       (cond
  487.        ;; It was a function, insert the function name
  488.        ((looking-at "fun\\b")
  489.         (setq tmp (concat " " (buffer-substring
  490.                                (progn (forward-char 3)
  491.                                       (skip-chars-forward "\t\n ") (point))
  492.                                (progn (forward-word 1) (point))) " "))
  493.         (setq case-or-handle-exp nil))
  494.        ;; It was a datatype, insert nothing
  495.        ((looking-at "datatype\\b\\|abstype\\b")
  496.         (setq tmp " ") (setq case-or-handle-exp nil))
  497.        ;; If it is an and, then we have to see what is was
  498.        ((looking-at "and\\b")
  499.         (let (isfun)
  500.           (save-excursion
  501.             (condition-case ()
  502.                 (progn
  503.                   (re-search-backward "datatype\\b\\|abstype\\b\\|fun\\b")
  504.                   (setq isfun (looking-at "fun\\b")))
  505.               (error (setq isfun nil))))
  506.           (if isfun
  507.               (progn
  508.                 (setq tmp
  509.                       (concat " " (buffer-substring
  510.                                    (progn (forward-char 3)
  511.                                           (skip-chars-forward "\t\n ") (point))
  512.                                    (progn (forward-word 1) (point))) " "))
  513.                 (setq case-or-handle-exp nil))
  514.             (setq tmp " ") (setq case-or-handle-exp nil))))))
  515.     (insert tmp)
  516.     (sml-indent-line)
  517.     (beginning-of-line)
  518.     (skip-chars-forward "\t ")
  519.     (forward-char (1+ (length tmp)))
  520.     (if case-or-handle-exp
  521.         (forward-char -4))))
  522.  
  523. (defun sml-electric-semi ()
  524.   "Inserts a \;.
  525. If variable sml-electric-semi-mode is t, indent the current line, insert 
  526. a newline, and indent."
  527.   (interactive)
  528.   (insert "\;")
  529.   (if sml-electric-semi-mode
  530.       (reindent-then-newline-and-indent)))
  531.  
  532. ;;; INDENTATION !!!
  533.  
  534. (defun sml-mark-function ()
  535.   "Synonym for mark-paragraph -- sorry.
  536. If anyone has a good algorithm for this..."
  537.   (interactive)
  538.   (mark-paragraph))
  539.  
  540. (defun sml-indent-region (begin end)
  541.   "Indent region of ML code."
  542.   (interactive "r")
  543.   (message "Indenting region...")
  544.   (save-excursion
  545.     (goto-char end) (setq end (point-marker)) (goto-char begin)
  546.     (while (< (point) end)
  547.       (skip-chars-forward "\t\n ")
  548.       (sml-indent-line)
  549.       (end-of-line))
  550.     (move-marker end nil))
  551.   (message "Indenting region... done"))
  552.  
  553. (defun sml-indent-line ()
  554.   "Indent current line of ML code."
  555.   (interactive)
  556.   (let ((indent (sml-calculate-indentation)))
  557.     (if (/= (current-indentation) indent)
  558.         (save-excursion                 ;; Added 890601 (point now stays)
  559.           (let ((beg (progn (beginning-of-line) (point))))
  560.             (skip-chars-forward "\t ")
  561.             (delete-region beg (point))
  562.             (indent-to indent))))
  563.     ;; If point is before indentation, move point to indentation
  564.     (if (< (current-column) (current-indentation))
  565.         (skip-chars-forward "\t "))))
  566.  
  567. (defun sml-back-to-outer-indent ()
  568.   "Unindents to the next outer level of indentation."
  569.   (interactive)
  570.   (save-excursion
  571.     (beginning-of-line)
  572.     (skip-chars-forward "\t ")
  573.     (let ((start-column (current-column))
  574.           (indent (current-column)))
  575.       (if (> start-column 0)
  576.           (progn
  577.             (save-excursion
  578.               (while (>= indent start-column)
  579.                 (if (re-search-backward "^[^\n]" nil t)
  580.                     (setq indent (current-indentation))
  581.                   (setq indent 0))))
  582.             (backward-delete-char-untabify (- start-column indent)))))))
  583.  
  584. (defconst sml-indent-starters-reg
  585.   "abstraction\\b\\|abstype\\b\\|and\\b\\|case\\b\\|datatype\\b\
  586. \\|else\\b\\|fun\\b\\|functor\\b\\|if\\b\\|sharing\\b\
  587. \\|in\\b\\|infix\\b\\|infixr\\b\\|let\\b\\|local\\b\
  588. \\|nonfix\\b\\|of\\b\\|open\\b\\|raise\\b\\|sig\\b\\|signature\\b\
  589. \\|struct\\b\\|structure\\b\\|then\\b\\|\\btype\\b\\|val\\b\
  590. \\|while\\b\\|with\\b\\|withtype\\b"
  591.   "The indentation starters. The next line will be indented.")
  592.  
  593. (defconst sml-starters-reg
  594.   "\\babstraction\\b\\|\\babstype\\b\\|\\bdatatype\\b\
  595. \\|\\bexception\\b\\|\\bfun\\b\\|\\bfunctor\\b\\|\\blocal\\b\
  596. \\|\\binfix\\b\\|\\binfixr\\b\\|\\bsharing\\b\
  597. \\|\\bnonfix\\b\\|\\bopen\\b\\|\\bsignature\\b\\|\\bstructure\\b\
  598. \\|\\btype\\b\\|\\bval\\b\\|\\bwithtype\\b\\|\\bwith\\b"
  599.   "The starters of new expressions.")
  600.  
  601. (defconst sml-end-starters-reg
  602.   "\\blet\\b\\|\\blocal\\b\\|\\bsig\\b\\|\\bstruct\\b\\|\\bwith\\b"
  603.   "Matching reg-expression for the \"end\" keyword.")
  604.  
  605. (defconst sml-starters-indent-after
  606.   "let\\b\\|local\\b\\|struct\\b\\|in\\b\\|sig\\b\\|with\\b"
  607.   "Indent after these.")
  608.  
  609. (defun sml-calculate-indentation ()
  610.   (save-excursion
  611.     (let ((case-fold-search nil))
  612.       (beginning-of-line)
  613.       (if (bobp)                        ; Beginning of buffer
  614.           0                             ; Indentation = 0
  615.         (skip-chars-forward "\t ")
  616.         (cond
  617.          ;; Indentation for comments alone on a line, matches the
  618.          ;; proper indentation of the next line. Search only for the
  619.          ;; next "*)", not for the matching.
  620.          ((looking-at "(\\*")
  621.           (if (not (search-forward "*)" nil t))
  622.               (error "Comment not ended."))
  623.           (end-of-line)
  624.           (skip-chars-forward "\n\t ")
  625.           ;; If we are at eob, just indent 0
  626.           (if (eobp) 0 (sml-calculate-indentation)))
  627.          ;; Continued string ? (Added 890113 lbn)
  628.          ((looking-at "\\\\")
  629.           (save-excursion
  630.             (if (save-excursion (previous-line 1)
  631.                                 (beginning-of-line)
  632.                                 (looking-at "[\t ]*\\\\"))
  633.                 (progn (previous-line 1) (current-indentation))
  634.             (if (re-search-backward "[^\\\\]\"" nil t)
  635.                 (1+ (current-indentation))
  636.               0))))
  637.          ;; Are we looking at a case expression ?
  638.          ((looking-at "|.*=>")
  639.           (sml-skip-block)
  640.           (sml-re-search-backward "=>")
  641.           ;; Dont get fooled by fn _ => in case statements (890726)
  642.           ;; Changed the regexp a bit, so fn has to be first on line,
  643.           ;; in order to let the loop continue (Used to be ".*\bfn....")
  644.           ;; (900430).
  645.           (let ((loop t))
  646.             (while (and loop (save-excursion
  647.                                (beginning-of-line)
  648.                                (looking-at "[^ \t]+\\bfn\\b.*=>")))
  649.               (setq loop (sml-re-search-backward "=>"))))
  650.           (beginning-of-line)
  651.           (skip-chars-forward "\t ")
  652.           (cond
  653.            ((looking-at "|") (current-indentation))
  654.            ((and sml-case-indent (looking-at "of\\b"))
  655.             (1+ (current-indentation)))
  656.            ((looking-at "fn\\b") (1+ (current-indentation)))
  657.            ((looking-at "handle\\b") (+ (current-indentation) 5))
  658.            (t (+ (current-indentation) sml-pipe-indent))))
  659.          ((looking-at "and\\b")
  660.           (if (sml-find-matching-starter sml-starters-reg)
  661.               (current-column)
  662.             0))
  663.          ((looking-at "in\\b")          ; Match the beginning let/local
  664.           (sml-find-match-indent "in" "\\bin\\b" "\\blocal\\b\\|\\blet\\b"))
  665.          ((looking-at "end\\b")         ; Match the beginning
  666.           (sml-find-match-indent "end" "\\bend\\b" sml-end-starters-reg))
  667.          ((and sml-nested-if-indent (looking-at "else[\t ]*if\\b"))
  668.           (sml-re-search-backward "\\bif\\b\\|\\belse\\b")
  669.           (current-indentation))
  670.          ((looking-at "else\\b")        ; Match the if
  671.           (sml-find-match-indent "else" "\\belse\\b" "\\bif\\b" t))
  672.          ((looking-at "then\\b")        ; Match the if + extra indentation
  673.           (+ (sml-find-match-indent "then" "\\bthen\\b" "\\bif\\b" t)
  674.              sml-indent-level))
  675.          ((and sml-case-indent (looking-at "of\\b"))
  676.           (sml-re-search-backward "\\bcase\\b")
  677.           (+ (current-column) 2))
  678.          ((looking-at sml-starters-reg)
  679.           (let ((start (point)))
  680.             (sml-backward-sexp)
  681.             (if (and (looking-at sml-starters-indent-after)
  682.                      (/= start (point)))
  683.                 (+ (if sml-type-of-indent
  684.                        (current-column)
  685.                      (if (progn (beginning-of-line)
  686.                                 (skip-chars-forward "\t ")
  687.                                 (looking-at "|"))
  688.                          (- (current-indentation) sml-pipe-indent)
  689.                        (current-indentation)))
  690.                    sml-indent-level)
  691.               (beginning-of-line)
  692.               (skip-chars-forward "\t ")
  693.               (if (and (looking-at sml-starters-indent-after)
  694.                        (/= start (point)))
  695.                   (+ (if sml-type-of-indent
  696.                          (current-column)
  697.                        (current-indentation))
  698.                      sml-indent-level)
  699.                 (goto-char start)
  700.                 (if (sml-find-matching-starter sml-starters-reg)
  701.                     (current-column)
  702.                   0)))))
  703.          (t
  704.           (let ((indent (sml-get-indent)))
  705.             (cond
  706.              ((looking-at "|")
  707.               ;; Lets see if it is the follower of a function definition
  708.               (if (sml-find-matching-starter
  709.                    "\\bfun\\b\\|\\bfn\\b\\|\\band\\b\\|\\bhandle\\b")
  710.                   (cond
  711.                    ((looking-at "fun\\b") (- (current-column) sml-pipe-indent))
  712.                    ((looking-at "fn\\b") (1+ (current-column)))
  713.                    ((looking-at "and\\b") (1+ (1+ (current-column))))
  714.                    ((looking-at "handle\\b") (+ (current-column) 5)))
  715.                 (+ indent sml-pipe-indent)))
  716.              (t
  717.               (if sml-paren-lookback    ; Look for open parenthesis ?
  718.                   (max indent (sml-get-paren-indent))
  719.                 indent))))))))))
  720.  
  721. (defun sml-get-indent ()
  722.   (save-excursion
  723.     (let ((case-fold-search nil))
  724.       (beginning-of-line)
  725.       (skip-chars-backward "\t\n; ")
  726.       (if (looking-at ";") (sml-backward-sexp))
  727.       (cond
  728.        ((save-excursion (sml-backward-sexp) (looking-at "end\\b"))
  729.         (- (current-indentation) sml-indent-level))
  730.        (t
  731.         (while (/= (current-column) (current-indentation))
  732.           (sml-backward-sexp))
  733.         (skip-chars-forward "\t |")
  734.         (let ((indent (current-column)))
  735.           (skip-chars-forward "\t (")
  736.           (cond
  737.            ;; Started val/fun/structure...
  738.            ((looking-at sml-indent-starters-reg)
  739.             (+ (current-column) sml-indent-level))
  740.            ;; Indent after "=>" pattern, but only if its not an fn _ =>
  741.            ;; (890726)
  742.            ((looking-at ".*=>")
  743.             (if (looking-at ".*\\bfn\\b.*=>")
  744.                 indent
  745.               (+ indent sml-indent-level)))
  746.            ;; else keep the same indentation as previous line
  747.            (t indent))))))))
  748.  
  749. (defun sml-get-paren-indent ()
  750.   (save-excursion
  751.     (let ((levelpar 0)                  ; Level of "()"
  752.           (levelcurl 0)                 ; Level of "{}"
  753.           (levelsqr 0)                  ; Level of "[]"
  754.           (backpoint (max (- (point) sml-paren-lookback) (point-min))))
  755.       (catch 'loop
  756.         (while (and (/= levelpar 1) (/= levelsqr 1) (/= levelcurl 1))
  757.           (if (re-search-backward "[][{}()]" backpoint t)
  758.               (if (not (sml-inside-comment-or-string-p))
  759.                   (cond
  760.                    ((looking-at "(") (setq levelpar (1+ levelpar)))
  761.                    ((looking-at ")") (setq levelpar (1- levelpar)))
  762.                    ((looking-at "\\[") (setq levelsqr (1+ levelsqr)))
  763.                    ((looking-at "\\]") (setq levelsqr (1- levelsqr)))
  764.                    ((looking-at "{") (setq levelcurl (1+ levelcurl)))
  765.                    ((looking-at "}") (setq levelcurl (1- levelcurl)))))
  766.             (throw 'loop 0)))           ; Exit with value 0
  767.         (if (save-excursion
  768.               (forward-char 1)
  769.               (looking-at sml-indent-starters-reg))
  770.             (1+ (+ (current-column) sml-indent-level))
  771.           (1+ (current-column)))))))
  772.  
  773. (defun sml-inside-comment-or-string-p ()
  774.   (let ((start (point)))
  775.     (if (save-excursion
  776.           (condition-case ()
  777.               (progn
  778.                 (search-backward "(*")
  779.                 (search-forward "*)")
  780.                 (forward-char -1)       ; A "*)" is not inside the comment
  781.                 (> (point) start))
  782.             (error nil)))
  783.         t
  784.       (let ((numb 0))
  785.         (save-excursion
  786.           (save-restriction
  787.             (narrow-to-region (progn (beginning-of-line) (point)) start)
  788.             (condition-case ()
  789.                 (while t
  790.                   (search-forward "\"")
  791.                   (setq numb (1+ numb)))
  792.               (error (if (and (not (zerop numb))
  793.                               (not (zerop (% numb 2))))
  794.                          t nil)))))))))
  795.  
  796. (defun sml-skip-block ()
  797.   (let ((case-fold-search nil))
  798.     (sml-backward-sexp)
  799.     (if (looking-at "end\\b")
  800.         (progn
  801.           (goto-char (sml-find-match-backward "end" "\\bend\\b"
  802.                                               sml-end-starters-reg))
  803.           (skip-chars-backward "\n\t "))
  804.       ;; Here we will need to skip backward past if-then-else
  805.       ;; and case-of expression. Please - tell me how !!
  806.       )))
  807.  
  808. (defun sml-find-match-backward (unquoted-this this match &optional start)
  809.   (save-excursion
  810.     (let ((case-fold-search nil)
  811.           (level 1)
  812.           (pattern (concat this "\\|" match)))
  813.       (if start (goto-char start))
  814.       (while (not (zerop level))
  815.         (if (sml-re-search-backward pattern)
  816.             (setq level (cond
  817.                          ((looking-at this) (1+ level))
  818.                          ((looking-at match) (1- level))))
  819.           ;; The right match couldn't be found
  820.           (error (concat "Unbalanced: " unquoted-this))))
  821.       (point))))
  822.  
  823. (defun sml-find-match-indent (unquoted-this this match &optional indented)
  824.   (save-excursion
  825.     (goto-char (sml-find-match-backward unquoted-this this match))
  826.     (if (or sml-type-of-indent indented)
  827.         (current-column)
  828.       (if (progn
  829.             (beginning-of-line)
  830.             (skip-chars-forward "\t ")
  831.             (looking-at "|"))
  832.           (- (current-indentation) sml-pipe-indent)
  833.         (current-indentation)))))
  834.  
  835. (defun sml-find-matching-starter (regexp)
  836.   (let ((case-fold-search nil)
  837.         (start-let-point (sml-point-inside-let-etc))
  838.         (start-up-list (sml-up-list))
  839.         (found t))
  840.     (if (sml-re-search-backward regexp)
  841.         (progn
  842.           (condition-case ()
  843.               (while (or (/= start-up-list (sml-up-list))
  844.                          (/= start-let-point (sml-point-inside-let-etc)))
  845.                 (re-search-backward regexp))
  846.             (error (setq found nil)))
  847.           found)
  848.       nil)))
  849.  
  850. (defun sml-point-inside-let-etc ()
  851.   (let ((case-fold-search nil) (last nil) (loop t) (found t) (start (point)))
  852.     (save-excursion
  853.       (while loop
  854.         (condition-case ()
  855.             (progn
  856.               (re-search-forward "\\bend\\b")
  857.               (while (sml-inside-comment-or-string-p)
  858.                 (re-search-forward "\\bend\\b"))
  859.               (forward-char -3)
  860.               (setq last (sml-find-match-backward "end" "\\bend\\b"
  861.                                                   sml-end-starters-reg last))
  862.               (if (< last start)
  863.                   (setq loop nil)
  864.                 (forward-char 3)))
  865.           (error (progn (setq found nil) (setq loop nil)))))
  866.       (if found
  867.           last
  868.         0))))
  869.  
  870. (defun sml-re-search-backward (regexpr)
  871.   (let ((case-fold-search nil) (found t))
  872.     (if (re-search-backward regexpr nil t)
  873.         (progn
  874.           (condition-case ()
  875.               (while (sml-inside-comment-or-string-p)
  876.                 (re-search-backward regexpr))
  877.             (error (setq found nil)))
  878.           found)
  879.       nil)))
  880.  
  881. (defun sml-up-list ()
  882.   (save-excursion
  883.     (condition-case ()
  884.         (progn
  885.           (up-list 1)
  886.           (point))
  887.       (error 0))))
  888.  
  889. (defun sml-backward-sexp ()
  890.   (condition-case ()
  891.       (progn
  892.         (let ((start (point)))
  893.           (backward-sexp 1)
  894.           (while (and (/= start (point)) (looking-at "(\\*"))
  895.             (setq start (point))
  896.             (backward-sexp 1))))
  897.     (error (forward-char -1))))
  898.  
  899. (defun sml-comment-indent ()
  900.   (if (looking-at "^(\\*")              ; Existing comment at beginning
  901.       0                                 ; of line stays there.
  902.     (save-excursion
  903.       (skip-chars-backward " \t")
  904.       (max (1+ (current-column))        ; Else indent at comment column
  905.            comment-column))))           ; except leave at least one space.
  906.  
  907. ;;; INSERTING PROFORMAS (COMMON SML-FORMS) 
  908.  
  909. (defvar sml-forms-alist
  910.   '(("let") ("local") ("case") ("abstype") ("datatype")
  911.     ("signature") ("structure") ("functor"))
  912.   "*The list of templates to auto-insert.
  913.  
  914. You can extend this alist to your heart's content. For each additional
  915. template NAME in the list, declare a keyboard macro or function (or
  916. interactive command) called 'sml-form-NAME'.
  917.  
  918. If 'sml-form-NAME' is a function it takes no arguments and should
  919. insert the template at point\; if this is a command it may accept any
  920. sensible interactive call arguments\; keyboard macros can't take
  921. arguments at all. Apropos keyboard macros, see `name-last-kbd-macro'
  922. and `sml-addto-forms-alist'.
  923.  
  924. `sml-forms-alist' understands let, local, case, abstype, datatype,
  925. signature, structure, and functor by default.")
  926.  
  927. ;; See also macros.el in emacs lisp dir.
  928.  
  929. (defun sml-addto-forms-alist (name)
  930.   "Assign a name to the last keyboard macro defined.
  931. Argument NAME is transmogrified to sml-form-NAME which is the symbol
  932. actually defined. 
  933.  
  934. The symbol's function definition becomes the keyboard macro string.
  935.  
  936. If that works, NAME is added to `sml-forms-alist' so you'll be able to
  937. reinvoke the macro through \\[sml-insert-form]. You might want to save
  938. the macro to use in a later editing session -- see `insert-kbd-macro'
  939. and add these macros to your .emacs file.
  940.  
  941. See also `edit-kbd-macro' which is bound to \\[edit-kbd-macro]."
  942.   (interactive "sName for last kbd macro (\"sml-form-\" will be added): ")
  943.   (if (string-equal name "")
  944.       (error "No command name given")
  945.     (name-last-kbd-macro (intern (concat "sml-form-" name)))
  946.     (message (concat "Macro bound to sml-form-" name))
  947.     (or (assoc name sml-forms-alist)
  948.         (setq sml-forms-alist (cons (list name) sml-forms-alist)))))
  949.  
  950. ;; at a pinch these could be added to SML/Forms menu through the good
  951. ;; offices of activate-menubar-hook or something... but documentation
  952. ;; of this and/or menu-bar-update-hook is sparse in 19.33. anyway, use
  953. ;; completing read for sml-insert-form prompt...
  954.  
  955. (defvar sml-last-form "let"
  956.   "The most recent sml form inserted.")
  957.  
  958. (defun sml-insert-form (arg)
  959.   "Interactive short-cut to insert a common ML form.
  960. If a perfix argument is given insert a newline and indent first, or
  961. just move to the proper indentation if the line is blank\; otherwise
  962. insert at point (which forces indentation to current column).
  963.  
  964. The default form to insert is 'whatever you inserted last time'
  965. \(just hit return when prompted\)\; otherwise the command reads with 
  966. completion from `sml-forms-alist'."
  967.   (interactive "P")
  968.   (let ((name (completing-read
  969.                (format "Form to insert: (default %s) " sml-last-form)
  970.                sml-forms-alist nil t nil)))
  971.     ;; default is whatever the last insert was...
  972.     (if (string= name "") (setq name sml-last-form))
  973.     (setq sml-last-form name)
  974.     (if arg
  975.         (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
  976.             (sml-indent-line)
  977.           (newline-and-indent)))
  978.     (cond ((string= name "let") (sml-form-let))
  979.           ((string= name "local") (sml-form-local))
  980.           ((string= name "case") (sml-form-case))
  981.           ((string= name "abstype") (sml-form-abstype))
  982.           ((string= name "datatype") (sml-form-datatype))
  983.           ((string= name "functor") (sml-form-functor))
  984.           ((string= name "structure") (sml-form-structure))
  985.           ((string= name "signature") (sml-form-signature))
  986.           (t
  987.            (let ((template (intern (concat "sml-form-" name))))
  988.              (if (fboundp template)
  989.                  (if (commandp template)
  990.                      ;; it may be a named kbd macro too
  991.                      (command-execute template)
  992.                    (funcall template))
  993.                (error
  994.                 (format "Undefined format function: %s" template))))))))
  995.  
  996. (defun sml-form-let () 
  997.   "Insert a `let in end' template."
  998.   (interactive)
  999.   (sml-let-local "let"))
  1000.  
  1001. (defun sml-form-local ()
  1002.   "Insert a `local in end' template."
  1003.   (interactive)
  1004.   (sml-let-local "local"))
  1005.  
  1006. (defun sml-let-local (starter)
  1007.   "Insert a let or local template, depending on STARTER string."
  1008.   (let ((indent (current-column)))
  1009.     (insert starter)
  1010.     (insert "\n") (indent-to (+ sml-indent-level indent))
  1011.     (save-excursion                     ; so point returns here
  1012.       (insert "\n")
  1013.       (indent-to indent)
  1014.       (insert "in\n")
  1015.       (indent-to (+ sml-indent-level indent))
  1016.       (insert "\n")
  1017.       (indent-to indent)
  1018.       (insert "end"))))
  1019.  
  1020. (defun sml-form-case ()
  1021.   "Insert a case expression template, prompting for the case-expresion."
  1022.   (interactive)
  1023.   (let ((expr (read-string "Case expr: "))
  1024.         (indent (current-column)))
  1025.     (insert (concat "case " expr))
  1026.     (if sml-case-indent
  1027.         (progn
  1028.           (insert "\n")
  1029.           (indent-to (+ 2 indent))
  1030.           (insert "of "))
  1031.       (insert " of\n")
  1032.       (indent-to (+ indent sml-indent-level)))
  1033.     (save-excursion (insert " => "))))
  1034.  
  1035. (defun sml-form-signature ()
  1036.   "Insert a generative signature binding, prompting for the name."
  1037.   (interactive)
  1038.   (let ((indent (current-column))
  1039.         (name (read-string "Signature name: ")))
  1040.     (insert (concat "signature " name " ="))
  1041.     (insert "\n")
  1042.     (indent-to (+ sml-structure-indent indent))
  1043.     (insert "sig\n")
  1044.     (indent-to (+ sml-structure-indent sml-indent-level indent))
  1045.     (save-excursion
  1046.       (insert "\n")
  1047.       (indent-to (+ sml-structure-indent indent))
  1048.       (insert "end"))))
  1049.  
  1050. (defun sml-form-structure ()
  1051.   "Insert a generative structure binding, prompting for the name.
  1052. The command also prompts for any signature constraint -- you should
  1053. specify \":\" or \":>\" and the constraining signature."
  1054.   (interactive)
  1055.   (let ((indent (current-column))
  1056.         (name (read-string (concat "Structure name: ")))
  1057.         (signame (read-string "Signature constraint (default none): ")))
  1058.     (insert (concat "structure " name " "))
  1059.     (insert (if (string= "" signame) "=" (concat signame " =")))
  1060.     (insert "\n")
  1061.     (indent-to (+ sml-structure-indent indent))
  1062.     (insert "struct\n")
  1063.     (indent-to (+ sml-structure-indent sml-indent-level indent))
  1064.     (save-excursion
  1065.       (insert "\n")
  1066.       (indent-to (+ sml-structure-indent indent))
  1067.       (insert "end"))))
  1068.  
  1069. (defun sml-form-functor ()
  1070.   "Insert a genarative functor binding, prompting for the name.
  1071. The command also prompts for the required signature constraint -- you
  1072. should specify \":\" or \":>\" and the constraining signature."
  1073.   (interactive)
  1074.   (let ((indent(current-indentation))
  1075.         (name (read-string "Name of functor: "))
  1076.         (signame (read-string "Signature constraint: " ":" )))
  1077.     (insert (concat "functor " name " () " signame " ="))
  1078.     (insert "\n")
  1079.     (indent-to (+ sml-structure-indent indent))
  1080.     (insert "struct\n")
  1081.     (indent-to (+ sml-structure-indent sml-indent-level indent))
  1082.     (save-excursion                     ; return to () instead?
  1083.       (insert "\n")
  1084.       (indent-to (+ sml-structure-indent indent))
  1085.       (insert "end"))))
  1086.  
  1087. (defun sml-form-datatype ()
  1088.   "Insert a datatype declaration, prompting for name and type parameter."
  1089.   (interactive)
  1090.   (let ((indent (current-indentation))
  1091.         (type (read-string "Datatype type parameter (default none): "))
  1092.         (name (read-string (concat "Name of datatype: "))))
  1093.     (insert (concat "datatype "
  1094.                     (if (string= type "") "" (concat type " "))
  1095.                     name " ="))
  1096.     (insert "\n")
  1097.     (indent-to (+ sml-indent-level indent))))
  1098.  
  1099. (defun sml-form-abstype ()
  1100.   "Insert an abstype declaration, prompting for name and type parameter."
  1101.   (interactive)
  1102.   (let ((indent(current-indentation))
  1103.         (type (read-string "Abstype type parameter (default none): "))
  1104.         (name (read-string "Name of abstype: ")))
  1105.     (insert (concat "abstype "
  1106.                     (if (string= type "") "" (concat type " "))
  1107.                     name " ="))
  1108.     (insert "\n")
  1109.     (indent-to (+ sml-indent-level indent))
  1110.     (save-excursion
  1111.       (insert "\n")
  1112.       (indent-to indent)
  1113.       (insert "with\n")
  1114.       (indent-to (+ sml-indent-level indent))
  1115.       (insert "\n")
  1116.       (indent-to indent)
  1117.       (insert "end"))))
  1118.  
  1119. ;;; Load the menus, if they can be found on the load-path
  1120.  
  1121. (condition-case nil
  1122.     (require 'sml-menus)
  1123.   (error (message "Sorry, not able to load SML mode menus.")))
  1124.  
  1125. ;;; & do the user's customisation
  1126.  
  1127. (add-hook 'sml-load-hook 'sml-mode-version t)
  1128.  
  1129. (run-hooks 'sml-load-hook)
  1130.  
  1131. ;;; sml-mode.el has just finished.
  1132.